home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1994 June: Reference Library / Dev.CD Jun 94.toast / Periodicals / develop / develop Issue 5 / develop 5 code / Lisp Mini-App / Program / palette-class.lisp < prev    next >
Encoding:
Text File  |  1992-04-08  |  6.3 KB  |  157 lines  |  [TEXT/CCL2]
  1. #|
  2.    palette-class.lisp
  3.  
  4.    Defines the PALETTE class, and its behavior (its attributes, how it 
  5.    is created, displayed, closed, and what happens when it is clicked on),
  6.    used in the Mini-Application sample program.
  7.  
  8.    For further info, see files "About Mini-App" and "Instructions".
  9.  
  10.  
  11.    Copyright 1990, 1991 by Ruben Kleiman for Apple Computer, Inc.
  12.  
  13.    Change History.
  14.    03-11-92 slm  *standard-item-height* & *standard-item-width*
  15.                  removed as actually local to function layout.
  16.    03-09-92 slm  Updated file header comments.
  17.  
  18. |#
  19.  
  20. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  21. ;;; PALETTE window class
  22. ;;;
  23. ;;;    This class will be used to create instances of palettes which can be
  24. ;;;    used for selecting tools and for dragging objects into the draw windows.
  25. ;;;    Since the DRAW-DIALOG class has methods which are useful for the PALETTE
  26. ;;;    class, we will make PALETTE a subclass of it.  We wish palettes to be
  27. ;;;    floating windows.  MCL defines a window class called WINDOID which
  28. ;;;    has this property.  Therefore, we will use multiple inheritance to get
  29. ;;;    the best of both worlds.  We will override or modify the behavior of
  30. ;;;    DRAW-DIALOG methods as needed for PALETTE.
  31. ;;;
  32. ;;;      my-tools      -- a list of tool items to be shown in a palette
  33. ;;;      my-draw-items -- a list of draw items which can be dragged
  34. ;;;                       from a palette onto a window
  35. ;;;
  36. (defclass palette (draw-dialog)
  37.   ((my-tools      :initarg :tools)
  38.    (my-draw-items :initarg :draw-items))
  39.   (:documentation "The class of palettes used in our application"))
  40.  
  41. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  42. ;;; window-close
  43. ;;;
  44. ;;;   This will ensure that when the close box is clicked,
  45. ;;;   the palette will merely hide and that the Palette
  46. ;;;   menu item is enabled.
  47. ;;;
  48. (defmethod window-close ((palette palette))
  49.   (menu-item-enable *palette-menu-item*)
  50.   (window-hide palette))
  51.  
  52. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  53. ;;; view-click-event-handler
  54. ;;;
  55. ;;; This gets called by MCL when the mouse goes down in the palette.
  56. ;;; We want to make sure that the palette always dispatches the
  57. ;;; mouse-down event because tools need it.  The rest of the behavior is the
  58. ;;; same as in the draw-dialog windows, except that palettes are always
  59. ;;; in author mode
  60. ;;;
  61. (defmethod view-click-event-handler ((palette palette) where)
  62.   (let ((item (find-view-containing-point palette where)))
  63.     (mouse-down item where)     ; dispatch the mouse-down event
  64.     (call-next-method)))        ; proceed with the usual behavior
  65.  
  66. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  67. ;;; layout
  68. ;;;
  69. ;;;   This gets called when a palette must be laid out.
  70. ;;;   It provides a reasonable palette layout, based on the tools and
  71. ;;;   draw-items provided for it.
  72. ;;;
  73. (defmethod layout ((palette palette))
  74.   (let* ((tools      (slot-value palette 'my-tools))
  75.          (draw-items (slot-value palette 'my-draw-items))
  76.          (v 10)      ; starting vertical
  77.          (default-item-width  16)
  78.          (default-item-height 16)
  79.          (max-item-width 0)
  80.          size)
  81.     ;; Local function layout-item will be used twice below:
  82.     (labels ((layout-item (item start-h)
  83.                (unless (view-size item)
  84.                  (set-view-size item default-item-width default-item-height))
  85.                (setf size (view-size item))
  86.                (setf max-item-width (max (point-h size) max-item-width))
  87.                (set-view-position item start-h v)
  88.                (setf v (+ v (point-v size) 4))))
  89.       ;; Layout the tools:
  90.       (dolist (tool tools)
  91.         (layout-item tool 16))
  92.       ;; Provide extra separation between tools and draw-items:
  93.       (setq v (+ v 8))
  94.       ;; Layout the draw-items:
  95.       (dolist (draw-item draw-items)
  96.         (layout-item draw-item 24)))
  97.     ;; Now add the tools and draw-items into the palette:
  98.     (apply #'add-items (cons palette tools))
  99.     (apply #'add-items (cons palette draw-items))
  100.     (set-view-size palette (+ max-item-width 32) v)))
  101.  
  102. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103. ;;; add-items
  104. ;;;
  105. ;;;   This is called to put draw-items into a window
  106. ;;;   It creates the rectangle used to drag and resize it
  107. ;;;   under direct manipulation
  108. ;;;
  109. (defmethod add-items ((window draw-dialog) &rest items)
  110.   (dolist (item items)
  111.     ;; Set draw-item's rectangle for tracking
  112.     (setf (slot-value item 'rectangle)
  113.           (make-record :rect
  114.                        :topleft (view-position item)
  115.                        :bottomright (add-points (view-position item)
  116.                                                 (view-size item)))))
  117.   (apply #'add-subviews (cons window items)))
  118.  
  119. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  120. ;;; show-palette
  121. ;;;
  122. ;;;   Show palette, if it exists; else create one and show it.
  123. ;;;   Remember to update the Palette menu item hiliting.
  124. ;;;   We assume that the global variables *available-tools* and
  125. ;;;   *available-draw-items* are lists of already defined tools
  126. ;;;   and draw items, respectively.  The tools and draw items
  127. ;;;   are defined below, in the DRAW ITEMS section
  128. ;;;
  129. (defun show-palette ()
  130.   (let ((palette (car (windows :class 'palette))))
  131.     (if palette
  132.       (window-show palette)
  133.       (setq palette (create-palette)))
  134.     (menu-item-enable *palette-menu-item*)))
  135.  
  136. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  137. ;;; create-palette
  138. ;;;
  139. ;;;   Creates, does the layout for and returns a brand new palette
  140. ;;;
  141. (defun create-palette (&key (tools *available-tools*)
  142.                             (items *available-draw-items*))
  143.   (let ((palette (make-instance 'palette
  144.                                 :window-title  "Tools"
  145.                                 :window-type   :tool
  146.                                 :window-show   nil
  147.                                 :view-position #@(310 40)
  148.                                 :view-size     #@(100 300)
  149.                                 :tools         tools
  150.                                 :draw-items    items)))
  151.     (layout palette)
  152.     (window-show palette)
  153.     palette))
  154.  
  155. ;end of file palette-class.lisp
  156. ;------------------------------------------------
  157.